﻿
#If Not (PocketPC Or Smartphone) Then

Imports System.Threading
Imports System.Net
Imports std
Imports hddoslite

Public Class httpServerOld
    Private Shared ReadOnly HTTP_REQUEST_COUNTER As Int64
    Private Shared ReadOnly HTTP_REJECT_COUNTER As Int64
    Private Shared ReadOnly HTTP_RESPONSE_TIMEMS As Int64
    Private Shared ReadOnly HTTP_SEND_BYTES_MS As Int64
    Private Shared ReadOnly HTTP_REQUEST_5sQPS As Int64
    Private Shared ReadOnly HTTP_REJECT_5sQPS As Int64

    Public Const portsSeperators As String = character.comma + character.sheffer
    Public Event receive(ByVal context As HttpListenerContext)
    Public Event reject(ByVal context As HttpListenerContext, ByVal rejectIssues As Byte)
    Public maxConnectionCount As Int32 = 1024
    Private listener As HttpListener = Nothing
    Protected _stopsign As Boolean = False
    Private thread As Thread = Nothing
    Private connCount As Int32
    Private prefixes As [set](Of String) = Nothing

    Private hddoslite As hddoslite = Nothing

    Public Function hddosliteEnabled() As Boolean
        Return Not hddoslite Is Nothing
    End Function

    Public Sub enableHDDoSLite(ByVal config As configParser, _
                               Optional ByVal section As String = configNaming.hddos.name)
        hddoslite = New hddoslite(config, section)
    End Sub

    Public Sub addHDDoSLiteBypassPaths(ByVal ParamArray paths() As String)
        If Not hddoslite Is Nothing Then
            hddoslite.addBypassPaths(paths)
        End If
    End Sub

    Public Sub disableHDDoSLite()
        hddoslite = Nothing
    End Sub

    Public Sub clearprefix()
        On Error Resume Next

        assert(Not prefixes Is Nothing, "prefixes is nothing before addprefix")
        prefixes.clear()
        If Not listener Is Nothing AndAlso Not listener.Prefixes Is Nothing Then
            listener.Prefixes.Clear()
        End If
    End Sub

    Public Sub addprefix(ByVal prefix As String)
        assert(Not prefixes Is Nothing, "prefixes is nothing before addprefix")
        prefixes.insert(prefix)
    End Sub

    Public Sub addport(ByVal port As Int32)
        addprefix(httpAddressHeader + character.asterisk + network.portMark + _
                  Convert.ToString(port) + network.pathSeperator)
    End Sub

    Public Sub addprefixes(ByVal prefixes As String)
        Dim prefixset As vector(Of String) = Nothing
        strsepar(prefixes, character.comma, prefixset)
        Dim i As Int32
        For i = 0 To prefixset.size() - 1
            addprefix(prefixset(i))
        Next
    End Sub

    Public Sub addports(ByVal ports As String)
        Dim portset As vector(Of String) = Nothing
        strsepar(ports, portsSeperators, portset, True)
        Dim i As Int32
        For i = 0 To portset.size() - 1
            Dim port As Int32
            If convertor.toint32(portset(i), port) Then
                addport(port)
            Else
                raiseError("cannot convert port to int32, " + portset(i) + ", ignore." _
                           , errorHandle.errorType.exclamation)
            End If
        Next
    End Sub

    Public Function active() As Boolean
        Return Not listener Is Nothing AndAlso listener.IsListening()
    End Function

    Public Function health() As Boolean
        Return active() AndAlso Not thread Is Nothing AndAlso thread.IsAlive()
    End Function

    Public Overridable Sub [stop]()
        _stopsign = True
        clearprefix()
        If Not listener Is Nothing Then
            listener.Close()
        End If
        If Not thread Is Nothing AndAlso thread.IsAlive() Then
            thread.Join(60000)
        End If
        If Not thread Is Nothing AndAlso thread.IsAlive() Then
            thread.Abort()
        End If
        listener = Nothing
    End Sub

    Private Sub beginContextHandle(ByVal context As HttpListenerContext)
        'fit the workaround in contentType & referer & userAgent
        contentType(context)
        referer(context)
        userAgent(context)
    End Sub

    Private Sub closecontext(ByVal context As HttpListenerContext)
        Try
            closestream(context.Response.OutputStream)
            context.Response.Close()
        Catch
        End Try
    End Sub

    Private Sub releaseAccessing(ByVal context As HttpListenerContext)
        If Not hddoslite Is Nothing Then
            hddoslite.releaseAccessing(context)
        End If
    End Sub

    Protected Sub handle(ByVal obj As Object)
        Dim startms As Int64 = 0
        startms = ticksToMilliseconds(Now.Ticks)
        Dim context As HttpListenerContext = Nothing
        context = convertor.cast(Of HttpListenerContext)(obj)
        If isdebugmode() Then
            raiseError("accept request " + context.Request.Url.OriginalString)
        End If
        beginContextHandle(context)
        Dim responselength As Int64 = 0
        Try
            RaiseEvent receive(context)
        Catch ex As Exception
            raiseError("caught exception in receive, " + requestFullUrl(context) + ", " _
                       + ex.Message + ", " + ex.StackTrace(), errorHandle.errorType.warning)
        End Try
        If Not context Is Nothing AndAlso Not context.Response Is Nothing Then
            If isemptystring(context.Response.Headers(Net.HttpResponseHeader.Server)) Then
                addheader(context.Response.Headers, Net.HttpResponseHeader.Server, applicationSign())
            End If
            responselength = httpResponseLength(context.Response)
            closecontext(context)
        End If
        Interlocked.Decrement(connCount)
        Dim timems As Int64
        timems = ticksToMilliseconds(Now.Ticks) - startms
        counter.increase(HTTP_RESPONSE_TIMEMS, timems)
        counter.increase(HTTP_SEND_BYTES_MS, responselength \ ifoper(timems <= 0, 1, timems))
        counter.decrease(HTTP_REQUEST_COUNTER)
        releaseAccessing(context)
    End Sub

    Protected Overridable Sub startcontext(ByVal context As HttpListenerContext)
        Dim th As Thread = Nothing
        th = threads.startThread(AddressOf handle, context)
    End Sub

    Protected Sub rejectcontext(ByVal context As HttpListenerContext, ByVal rejectIssues As Byte)
        'do not care about reject context, so do not catch any error
        debugassert(Not context Is Nothing, "context is nothing.")
        If isdebugmode() Then
            raiseError("reject request " + context.Request.Url.OriginalString)
        End If
        beginContextHandle(context)
        Try
            RaiseEvent reject(context, rejectIssues)
        Catch ex As Exception
            raiseError("caught exception in reject, " + requestFullUrl(context) + ", " + _
                       ex.Message + ", " + ex.StackTrace(), errorHandle.errorType.warning)
        End Try
        closecontext(context)
        counter.decrease(HTTP_REJECT_COUNTER)
        releaseAccessing(context)
    End Sub

    Protected Sub listen2()
        'On Error Resume Next
        assert(Not listener Is Nothing, "cannot listen before listener is nothing.")
        assert(listener.IsListening(), "cannot listen before listener is listening.")
        'this assert is for httpServer ...
        assert(Not _stopsign, "should disable timer before _stopsign is set.")

        Dim context As HttpListenerContext = Nothing
        context = listener.GetContext()
        If Not context Is Nothing Then
            Dim accept As Boolean = False
            Dim rejectIssues As Byte = 0
            If hddoslite Is Nothing Then
                accept = True
            Else
                accept = (hddoslite.registerAccessing(context, rejectIssues) = ddoslite.returnValue.accept)
            End If

            If accept Then
                'this is only a control, but do not need to critically limit it.
                While connCount >= maxConnectionCount
                    sleep(100)
                End While
                Interlocked.Increment(connCount)
                counter.increase(HTTP_REQUEST_COUNTER)
                counter.increase(HTTP_REQUEST_5sQPS)
                startcontext(context)
            Else
                counter.increase(HTTP_REJECT_COUNTER)
                counter.increase(HTTP_REJECT_5sQPS)
                rejectcontext(context, rejectIssues)
            End If
        ElseIf Not _stopsign Then
            raiseError("cannot get context from listener, stop listening.", errorHandle.errorType.system)
            [stop]()
        End If
    End Sub

    Protected Sub listen()
        On Error Resume Next
        assert(Not listener Is Nothing, "cannot listen before listener is nothing.")

        While Not _stopsign AndAlso Not listener Is Nothing AndAlso listener.IsListening()
            listen2()
        End While
    End Sub

    Protected Sub importPrefixes()
        assert(Not prefixes Is Nothing, "prefixes is nothing before importPrefixes.")
        assert(Not listener Is Nothing, "listener is nothing before importPrefixes.")

        Dim it As [set](Of String).iterator = Nothing
        listener.Prefixes.Clear()
        it = prefixes.begin()
        While it <> prefixes.end()
            Try
                listener.Prefixes.Add(+it)
            Catch
                raiseError("fail to add prefix to listener, " + (+it) + ", ignore", errorHandle.errorType.exclamation)
            End Try
            it += 1
        End While
    End Sub

    Public Overridable Function start() As Boolean
        Try
            If HttpListener.IsSupported() Then
                _stopsign = False
                If listener Is Nothing Then
                    listener = New HttpListener()
                Else
                    listener.Stop()
                End If
                importPrefixes()
                listener.IgnoreWriteExceptions = True
                listener.Start()
                thread = New Thread(AddressOf listen)
                thread.Start()
                While thread.IsAlive() AndAlso Not active()
                    sleep(16)
                End While
                Return True
            Else
                raiseError("system does not support HttpListener.", errorHandle.errorType.system)
                Return False
            End If
        Catch ex As Exception
            raiseError("cannot start HttpServerOld, ex " + ex.Message + ", callstack " + ex.StackTrace, _
                       errorHandle.errorType.exclamation)
            Return False
        End Try
    End Function

    Public Sub New()
        prefixes = New [set](Of String)()
    End Sub

    Shared Sub New()
        HTTP_REQUEST_COUNTER = counter.register("HTTP_REQUEST_COUNTER")
        HTTP_REJECT_COUNTER = counter.register("HTTP_REJECT_COUNTER")
        HTTP_RESPONSE_TIMEMS = counter.registerAverageAndLastAverage("HTTP_RESPONSE_TIMEMS")
        HTTP_SEND_BYTES_MS = counter.registerAverageAndLastAverage("HTTP_SEND_BYTES_MS")
        HTTP_REQUEST_5sQPS = counter.registerRateAndLastRate("HTTP_REQUEST_5sQPS", intervalScale:=5)
        HTTP_REJECT_5sQPS = counter.registerRateAndLastRate("HTTP_REJECT_5sQPS", intervalScale:=5)
    End Sub
End Class

#End If
